MacWorld: Complete Mac Interactive/Macworld Complete Mac Interactive CD)(1994).iso/Software/More Shareware⁄Freeware/NIH Image 1.55 f (non fpu)/Macros/Editing Macros

Text File | 1994-04-20 | 5KB | 236 lines

var {Global variable, initially zero}
  RoiLeft,RoiTop,RoiRight,RoiBottom:integer;

macro 'Show Tools [T]';
begin
  SelectWindow('Tools');
end;

Macro 'Draw Arrow [A]'
{Draws an arrow based on the current straight line selection.}
var
  size,angle,dx,dy,pi,theta:real;
  x1,y1,x2,y2,LineWidth,width,height:integer;
begin
  size:=12;  {pixels}
  angle:=20; {degrees}
  pi:=3.14159;
  GetLine(x1,y1,x2,y2,LineWidth);
  if x1<0 then begin
    PutMessage('Use the line tool(straight) to select a line first.');
    exit;
  end;
  MoveTo(x1,y1);
  LineTo(x2,y2);
  KillRoi;
  GetPicSize(width,height);
  y1:=height-y1;
  y2:=height-y2;
  if LineWidth>1 then size:=size*LineWidth*0.5;
  angle:=(angle/180)*pi;
  dx:=x1-x2;
  dy:=y1-y2;
  if dx=0 then begin
    if dy>=0 then theta:=pi/2 else theta:=3/2*pi
  end else begin
    theta:=arctan(dy/dx);
    if dx<0 then theta:=theta+pi;
  end;
  moveto(x2,height-y2);
  lineto(x2+size*cos(theta+angle),height-(y2+size*sin(theta+angle)));
  moveto(x2,height-y2);
  lineto(x2+size*cos(theta-angle),height-(y2+size*sin(theta-angle)));
end;

macro 'Clear Outside [C]'
 {Erase region outside current selection to background color.}
begin
  Copy;
  SelectAll;
  Clear;
  RestoreRoi;
  Paste;
  KillRoi;
end;

macro 'Change Colors';
{
Changes the value of pixels in the image that are in
the current foreground color to the current background
color. Use Undo if you don't like the result.
}
var
  SavePixel,foreground,background:integer;
 begin
  SavePixel:=GetPixel(0,0);
  MakeRoi(0,0,1,1);
  Fill;
  foreground:=GetPixel(0,0);
  Clear;
  background:=GetPixel(0,0);
  PutPixel(0,0,SavePixel);
  PutMessage('Pixels in the foreground color (',foreground:1,') will be changed to the background color (',background:1,').');
  ChangeValues(foreground,foreground,background);
end;

macro 'Change Values…';
var
  v1,v2:integer;
begin
  v1:=GetNumber('Change pixels with this value:',255);
  v2:=GetNumber('to this value:',254);
  ChangeValues(v1,v1,v2);
end;

macro 'Fix Pseudocolors';
begin
  ChangeValues(0,0,1);
  ChangeValues(255,255,254);
end;

macro 'Remove Isolated Black Lines';
var
  width,height,value,x,y,xstart,ystart:integer;
begin
  GetRoi(xstart,ystart,width,height);
  if width=0 then begin
    PutMessage('This macro requires a retangular selection');
    exit;
  end;
  for y:=ystart to ystart+height-1 do begin
    if GetPixel(width div 2,y)=255 then
      for x:=xstart to xstart+width-1 do
        PutPixel(x,y,(GetPixel(x,y-1)+GetPixel(x,y+1))/2);
  end;
  KillRoi;
end;

macro 'Make Mosaic';
var
  n:integer;
begin
  SaveState;
  n:=GetNumber('Cell Size(pixels square):',8);
  Duplicate('Mosaic');
  SetScaling('Nearest; Same Window');
  ScaleSelection(1/n,1/n);
  RestoreRoi;
  ScaleSelection(n,n);
  RestoreState;
end;

macro 'Draw Grid…';
var
  x,y,xinc,yinc,width,height:integer;
begin
  GetPicSize(width,height);
  xinc:=GetNumber('Horizontal Spacing:',16);
  yinc:=GetNumber('Vertical Spacing:',xinc);
  x:=0;
  y:=0;
  repeat
    x:=x+xinc;
    y:=y+yinc;
    moveto(0,y);
    lineto(width,y);
    moveto(x,0);
    lineto(x,height);
  until (x>width) and (y>height);
end;

macro 'Make 256x256 Selection [S]';
{Creates a 256x256 selection centered on the image.}
var
  w,h:integer;
begin
  GetPicSize(w,h);
  MakeRoi((w-246)/2,(h-256)/2, 256, 256);
end;


macro 'Position fixed size ROI';
var width,height,x,y:integer;
begin
  width:=100; height:=100;
  repeat
     GetMouse(x,y);
     MakeRoi(x-width/2,y-height/2,width,height);
     DrawBoundary;
     Undo;
  until button;
end;

macro 'Flip ROI Horizontally';
{
Creates a "mirror image" of the current ROI.  It opens a temporary
blank window, transfers the ROI to that window, draws its outline,
flips the contents horizontally, creates a new marching ants ROI
using the AutoOutline command, restores the flipped ROI to the
original window, and then deletes the temporary window.
}
var
  hloc,vloc,width,height,pid1,pid2:integer;
begin
  RequiresVersion(1.55);
  GetRoi(hloc,vloc,width,height);
  if width=0 then begin
    PutMessage('This macro requires a selection');
    exit;
  end;
  SaveState;
  MoveRoi(-hloc,-vloc);
  KillRoi;
  SetNewSize(width+1,height);
  SetForegroundColor(255);
  SetBackgroundColor(0);
  pid1:=PidNumber;
  MakeNewWindow('Temp');
  RestoreRoi;
  DrawBoundary;
  SelectAll;
  FlipHorizontal;
  KillRoi;
  AutoOutline(0,height/2);
  pid2:=PidNumber;
  SelectPic(pid1);
  RestoreRoi;
  SelectPic(pid2);
  Dispose;
  RestoreState;
end;


macro '(-' begin end;

macro 'Define Upper Left [1]';
var
  x1,y1,x2,y2,LineWidth:integer;
begin
  GetLine(x1,y1,x2,y2,LineWidth);
  if x1<0 then begin
     PutMessage('Click with line selection tool to define upper left corner of ROI.');
     exit;
  end;
  RoiLeft:=x1+(x2-x1)/2;
  RoiTop:=y1+(y2-y1)/2;
end;

macro 'Define Lower Right and Create ROI [2]';
var
  x1,y1,x2,y2,LineWidth:integer;
begin
  GetLine(x1,y1,x2,y2,LineWidth);
  if x1<0 then begin
     PutMessage('Click with line selection tool to define lower right corner of ROI.');
     exit;
  end;
  RoiRight:=x1+(x2-x1)/2;
  RoiBottom:=y1+(y2-y1)/2;
  if (RoiLeft=RoiRight) and (RoiTop=RoiBottom) then begin
    PutMessage('Upper left and bottom right are the same.');
    exit;
  end;
  MakeRoi(RoiLeft,RoiTop,RoiRight-RoiLeft,RoiBottom-RoiTop)
end;